home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
twi12.zip
/
TWIDEMO.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-08-04
|
13KB
|
281 lines
Program TWIDemo;
(***********************************************************************)
(** Text Windowing Interface Copyright David Pabst 1992 **)
(** All Rights Reserved **)
(** Compuserve: 76547,2643 Relaynet: Pascal to David Pabst **)
(** **)
(** You may use, test, and\or develop software that uses TWI for **)
(** up to 1 month (31 days). You should not release software that **)
(** uses TWI before your register. If you do, your first registration **)
(** for that software must be put towards registering TWI. Either way**)
(** you must register after 31 days of use and demoing TWI. **)
(** TWI is shareware. YOU must register if this **)
(** software meets your needs. Registration is $15 (US) Check or **)
(** money order. **)
(** **)
(** $15 - David Pabst, 18 McAdams Road, Framingham, MA 01701, USA **)
(***********************************************************************)
uses TWI2,CRt;
Var (* Global Variables *)
SubA,SubB,SubC, Top, A, B, C, D, Bottom : string;
Option : char;
Done, Done2 : boolean;
(* ---------------- *)
Procedure InitVars; (* Intialize varaibles *)
Begin (* Init vars *)
fccf := 1; (* Fill character Color ForeGround *)
fccb := 7; (* Fill Character Color BackGround *)
wcol := 4; (* Word Color *)
FGC := 1; { Set some colors } (* Foreground Color *)
BGC := 7; (* Background Color *)
lc := 1; (* Line Color *)
Hfc := 1; (* Highlight Foreground Color *)
Hbc := 2; (* Highlight Background Color *)
Hc := 2; (* Highlight Color *)
Done := False;
FillChar := ('▒'); (* The character for the BKG fill in *)
Top := (' ');
Bottom := ('ESC Quit F1 Help F10 Menu '); (* Bottom Status Line *)
MenuA := ' = '; (* First menu Option will be = *)
menub := ' Demo '; (* 2nd option will be Demo *)
MenuC := ''; (* Clear the others *)
menud := '';
MenuE := '';
MenuF := '';
MenuG := '';
End; (* Intialize Variables *)
(* ---------------- *)
Procedure MoveAround; (* Move box on screen around - DEMO *)
Var
StatusLine : String;
X, Y, K : Integer;
Begin (* Move Around *)
X:= 2; (* X cooridinate *)
Y:= 3; (* Y cooridinate *)
Statusline:=('Arrw. Keys Move Window F10 Return to Main Environment ');
ChangeStatusLine('',Statusline); (* Change the status line on bottom *)
k:=y;
a:=('Use the arrow keys to move'); (* Setup a small Window *)
b:=('the window around the ');
c:=('screen. F10 returns you');
d:=('back to the main environment.');
DrawSmallWindow(A,b,c,d,x,y); (* Draw a small window with A,B,C,D *)
repeat
option := readkey; (* Get direction to move arrow *)
option := upcase(option); (* Upcase it just in case *)
case option of
#0 : Begin (* If an escape is pressed check for... *)
clearsmallwindow(x,y); (* Clear original window *)
option := readkey; (* Get direction *)
option := upcase(option);
case option of
#72 : Begin (* If up is pressed *)
y:=y-1;
if y<=2 then y:=3; (* If near the end of screen *)
clearsmallwindow(x,y); (* Clear Old Window *)
drawsmallwindow(a,b,c,d,x,y); (* Draw new window *)
done2 := true;
end;
#77 : Begin (* If right arrow is pressed *)
x:=x+1;
if x>=48 then x:=47;(* If near side of screen then *)
clearsmallwindow(x,y); (* Clear Old Window *)
drawsmallwindow(a,b,c,d,x,y); (* Place new window *)
done2 := true;
end;
#75 : Begin (* If left button is pressed *)
x:=x-1;
if x<=1 then x:=2; (* If near side of screen then *)
clearsmallwindow(x,y); (* Clear Old Window *)
drawsmallwindow(a,b,c,d,x,y); (* Draw new window *)
done2 := true;
end;
#80 : Begin (* If down is pressed *)
y:=y+1;
if y>=18 then y:=17;(* If near side of screen then *)
clearsmallwindow(x,y); (* Clear old window *)
drawsmallwindow(a,b,c,d,x,y); (* Draw new window *)
done2 := true;
end;
end; (* Case *)
end; (* Case *)
end;
until option = #68; (* Repeat until F10 is pressed *)
end; (* Move Around *)
(* ----------- *)
Procedure Information; (* Small info Window *)
Begin (* Information *)
DrawSmallWindow('This is a demo of Twi 1.0','','','(C) David Pabst 1992',25,8);
WaitForReturn; (* Wait until return is pressed *)
ClearSmallWindow(25,8); (* Clear window since its been read *)
End; (* Information *)
(* ----------- *)
Procedure SelectSubOption1; (* The Procedure for the 1st submenu *)
Var
whichway : char;
WhereSub : integer;
NewSelectMade : boolean;
Begin
WhereCursorIsReWrite(4,3,Suba); (* Place the highlighted cursor on *)
(* the first submenu *)
WhereSub := 1; (* Set the placement the computer is at *)
repeat
whichway := readkey; (* Get movement direction *)
case whichway of
#77,#75 : Begin (* Left\Right Move out of Submenu *)
ClearSmallWindow(1,2); (* Clear Sub Menu Off Screen *)
NewSelectmade := True; (* End submenu execution *)
End;
^M : Begin (* If Option is selected *)
information;
End;
End; (* Case *)
Until NewSelectMade; (* Repeat until done *)
ClearSmallWindow(1,2); (* Clear Sub Menu when Done *)
End; (* Select Sub Option 1 *)
(* ----------- *)
Procedure SelectSubOption2; (* The DEMO sub menu *)
Var
whichway : char;
WhereSub : integer;
NewSelectMade: boolean;
Begin
WhereCursorIsReWrite(11,3,Suba); (* Place cursor on 1st option in sub *)
WhereSub := 1; (* Place the counter on 1st option *)
repeat
whichway:=' '; (* Get direction or command *)
whichway := readkey;
case whichway of
#77,#75 : Begin (* If right\left is pressed clear *)
NewSelectMade := True; (* Stop executing sub menu *)
ClearSmallWindow(1,2); (* Clear Sub menu off screen *)
End;
^M : Begin (* If option is selected *)
If WhereSub = 1 then Begin (* If on first option *)
ClearSmallWindow(9,2); (* Clear SUb Menu *)
MoveAround; (* Call the move around Procedure *)
DrawSubMenu(SubA,Subb,Subc,SubC,SubC,SubC,Subc,Subc,9,2,2);
WhereCursorIsReWrite(11,3,Suba); (* Redraw sub after Move Around *)
WhereSub := 1;
MoveToLocal(2);
End;
If WhereSub = 2 then Begin (* Exit TWIDEMO *)
TwiClose; (* Close down TWI *)
End;
End;
#72 : Begin (* Move cursor up on screen *)
If WhereSub = 1 then Begin
WhereCursorIsReWrite(11,4,Subb); (* Move cursor *)
OldPlaceReWrite(11,3,Suba); (* Clear old cursor from screen *)
End;
If WhereSub = 2 then Begin
WhereCursorIsReWrite(11,3,Suba);
OldPlaceReWrite(11,4,Subb);
End;
If WhereSub = 1 then WhereSub :=3; (* If at top of menu goto bottom *)
WhereSub := WhereSub -1;
End;
#80 : Begin (* Move cursor down on menu *)
If WhereSub = 1 then Begin
OldPlaceReWrite(11,3,Suba);
WhereCursorIsReWrite(11,4,Subb);
End;
If WhereSub =2 then Begin
OldPlaceReWrite(11,4,Subb);
WhereCursorIsReWrite(11,3,Suba);
End;
WhereSub:=WhereSub+1; (* If at bottom move cursor to top *)
If WhereSub = 3 then WhereSub:=1;
End;
End;
Until NewSelectMade = True; (* If Done *)
End; (* SelectSub Option 2 *)
(* ---------------- *)
var
oldLocation, Location : integer;
KeyHit2, KeyHit : char;
SelectMade, going : boolean;
Begin (* Main Loop *)
Initvars; (* Initialize colors *)
QuickBkgDraw(Top, Bottom); (* Use the quick Background draw command *)
DefaultColors; (* You can call this insted of INITVARS *)
DrawMenus; (* Draw menu bar on top of screen *)
SelectMade := False; (* Make sure demo doesn't exit *)
oldLocation := 1; (* number 1 space on menu bar *)
Location := 1; (* Location of cursor on menu bar *)
movetolocal(Location); (* Place cursor on 1st option on menu bar *)
repeat (* Repeat Until you're done *)
option := readkey; (* Get direction of movement *)
option := upcase(option);
case option of
#27 : TWICLOSE; (* when escape is pressed = exit *)
#71 : Begin (* Jump to first place on menu bar *)
cleanoldLocation(oldLocation); (* Clean cursor off menu bar *)
Location := 1; (* Set location to 1st option on menu bar *)
movetolocal(Location); (* Move to space 1 on menu bar *)
oldLocation := Location; (* Make new place the old place of cursor *)
End;
#77 : Begin (* If right arrow is pressed *)
cleanoldLocation(oldLocation); (* Remove cursor from menu bar *)
Location := Location +1; (* Move location over one to right *)
If Location = 3 then Location := 1; (* if to far over go back *)
movetolocal(Location); (* Place cursor on screen *)
oldLocation := Location; (* Make new place the old place of cursor *)
End;
#75 : Begin (* If Left arrow is pressed *)
cleanoldLocation(oldLocation); (* Remove cursor from menu bar *)
If Location = 1 then Location := 2; (* just in case your off screen *)
Location := Location -1; (* Move cursor placement over 1 *)
movetolocal(Location); (* move cursor to new place on screen *)
oldLocation := Location; (* Make new location the old location *)
End;
^M,#80 : Begin (* If return or down is pressed *)
If Location = 1 then Begin (* If at 1st place on menu bar *)
Suba :=( 'Information');(* put INFO on sub menu *)
Subb := ''; (* Blank Space *)
DrawSubMenu(Suba,Subb,Subb,Subb,Subb,Subb,Subb,Subb,2,2,1);
SelectSubOption1; (* Call Sub Menu procedure *)
End;
If Location = 2 then Begin (* If at 2nd place on menu bar *)
Suba :=('Run Demo'); (* have run demo option *)
Subb :=('Exit Ctrl-Q');(* have exit demo option *)
Subc := '';
DrawSubMenu(Suba,Subb,Subc,Subc,Subc,Subc,Subc,Subc,9,2,2);
SelectSubOption2; (* Call Sub Menu 2 Procedure *)
End;
End; (* ^M, #80 *)
End; (* Case *)
Until SelectMade; (* Repeat until user is done *)
end. (* TWIDEmo *)